home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / viper / viper-mous.el.z / viper-mous.el
Encoding:
Text File  |  1998-05-21  |  23.6 KB  |  651 lines
  1. ;;; viper-mous.el --- mouse support for Viper
  2.  
  3. ;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
  4.  
  5. ;; This file is part of GNU Emacs.
  6.  
  7. ;; GNU Emacs is free software; you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 2, or (at your option)
  10. ;; any later version.
  11.  
  12. ;; GNU Emacs is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. ;; GNU General Public License for more details.
  16.  
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  19. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20. ;; Boston, MA 02111-1307, USA.
  21.  
  22. ;; Code
  23.  
  24. (provide 'viper-mous)
  25.  
  26. ;; compiler pacifier
  27. (defvar double-click-time)
  28. (defvar mouse-track-multi-click-time)
  29. (defvar viper-search-start-marker)
  30. (defvar viper-local-search-start-marker)
  31. (defvar viper-search-history)
  32. (defvar viper-s-string)
  33. (defvar viper-re-search)
  34.  
  35. ;; loading happens only in non-interactive compilation
  36. ;; in order to spare non-viperized emacs from being viperized
  37. (if noninteractive
  38.     (eval-when-compile
  39.       (let ((load-path (cons (expand-file-name ".") load-path)))
  40.     (or (featurep 'viper-util)
  41.         (load "viper-util.el" nil nil 'nosuffix))
  42.     (or (featurep 'viper-cmd)
  43.         (load "viper-cmd.el" nil nil 'nosuffix))
  44.     )))
  45. ;; end pacifier
  46.  
  47. (require 'viper-util)
  48.  
  49.  
  50. (defgroup viper-mouse nil
  51.   "Support for Viper special mouse-bound commands"
  52.   :prefix "viper-"
  53.   :group 'viper)
  54.  
  55.  
  56. ;;; Variables
  57.   
  58. ;; Variable used for catching the switch-frame event.
  59. ;; If non-nil, indicates that previous-frame should be the selected
  60. ;; one. Used by viper-mouse-click-get-word. Not a user option.
  61. (defvar viper-frame-of-focus nil)
  62.     
  63. ;; Frame that was selected before the switch-frame event.
  64. (defconst viper-current-frame-saved (selected-frame))
  65.   
  66. (defcustom viper-surrounding-word-function 'viper-surrounding-word
  67.   "*Function that determines what constitutes a word for clicking events.
  68. Takes two parameters: a COUNT, indicating how many words to return, 
  69. and CLICK-COUNT, telling whether this is the first click, a double-click,
  70. or a tripple-click."
  71.   :type 'boolean
  72.   :group 'viper-mouse)
  73.        
  74. ;; time interval in millisecond within which successive clicks are
  75. ;; considered related
  76. (defcustom viper-multiclick-timeout (if (viper-window-display-p)
  77.                       (if viper-xemacs-p
  78.                       mouse-track-multi-click-time
  79.                     double-click-time)
  80.                     500)
  81.   "*Time interval in millisecond within which successive mouse clicks are
  82. considered related."
  83.   :type 'integer
  84.   :group 'viper-mouse)
  85.  
  86. ;; current event click count; XEmacs only
  87. (defvar viper-current-click-count 0)
  88. ;; time stamp of the last click event; XEmacs only
  89. (defvar viper-last-click-event-timestamp 0)
  90.  
  91. ;; Local variable used to toggle wraparound search on click.
  92. (viper-deflocalvar  viper-mouse-click-search-noerror t)
  93.     
  94. ;; Local variable used to delimit search after wraparound.
  95. (viper-deflocalvar  viper-mouse-click-search-limit nil)
  96.     
  97. ;; remembers prefix argument to pass along to commands invoked by second
  98. ;; click.
  99. ;; This is needed because in Emacs (not XEmacs), assigning to preix-arg
  100. ;; causes Emacs to count the second click as if it was a single click
  101. (defvar viper-global-prefix-argument nil)
  102.  
  103.  
  104. ;; same keys, but parsed
  105. (defvar viper-mouse-up-search-key-parsed nil)
  106. (defvar viper-mouse-down-search-key-parsed nil)
  107. (defvar viper-mouse-up-insert-key-parsed nil)
  108. (defvar viper-mouse-down-insert-key-parsed nil)
  109.  
  110.  
  111.  
  112.  
  113. ;;; Code
  114.  
  115. (defsubst viper-multiclick-p ()
  116.   (not (viper-sit-for-short viper-multiclick-timeout t)))
  117.  
  118. ;; Returns window where click occurs
  119. (defun viper-mouse-click-window (click)
  120.   (let ((win (if viper-xemacs-p
  121.         (event-window click)
  122.           (posn-window (event-start click)))))
  123.     (if (window-live-p win)
  124.     win
  125.       (error "Click was not over a live window"))))
  126.  
  127. ;; Returns window where click occurs
  128. (defsubst viper-mouse-click-frame (click)
  129.   (window-frame (viper-mouse-click-window click)))
  130.  
  131. ;; Returns the buffer of the window where click occurs
  132. (defsubst viper-mouse-click-window-buffer (click)
  133.   (window-buffer (viper-mouse-click-window click)))
  134.  
  135. ;; Returns the name of the buffer in the window where click occurs
  136. (defsubst viper-mouse-click-window-buffer-name (click)
  137.   (buffer-name (viper-mouse-click-window-buffer click)))
  138.  
  139. ;; Returns position of a click
  140. (defsubst viper-mouse-click-posn (click)
  141.   (if viper-xemacs-p
  142.       (event-point click)
  143.     (posn-point (event-start click))))
  144.          
  145.  
  146. (defun viper-surrounding-word (count click-count)
  147.    "Returns word surrounding point according to a heuristic.
  148. COUNT indicates how many regions to return.
  149. If CLICK-COUNT is 1, `word' is a word in Vi sense.
  150. If CLICK-COUNT is 2,then `word' is a Word in Vi sense.
  151. If the character clicked on is a non-separator and is non-alphanumeric but
  152. is adjacent to an alphanumeric symbol, then it is considered alphanumeric
  153. for the purpose of this command. If this character has a matching
  154. character, such as `\(' is a match for `\)', then the matching character is
  155. also considered alphanumeric.
  156. For convenience, in Lisp modes, `-' is considered alphanumeric.
  157.  
  158. If CLICK-COUNT is 3 or more, returns the line clicked on with leading and
  159. trailing space and tabs removed. In that case, the first argument, COUNT,
  160. is ignored."
  161.    (let ((modifiers "")
  162.      beg skip-flag result
  163.      word-beg)
  164.      (if (> click-count 2)
  165.      (save-excursion
  166.        (beginning-of-line)
  167.        (viper-skip-all-separators-forward 'within-line)
  168.        (setq beg (point))
  169.        (end-of-line)
  170.        (setq result (buffer-substring beg (point))))
  171.        
  172.        (if (and (not (viper-looking-at-alphasep))
  173.         (or (save-excursion (viper-backward-char-carefully)
  174.                     (viper-looking-at-alpha))
  175.             (save-excursion (viper-forward-char-carefully)
  176.                     (viper-looking-at-alpha))))
  177.        (setq modifiers
  178.          (cond ((looking-at "\\\\") "\\\\")
  179.                ((looking-at "-") "C-C-")
  180.                ((looking-at "[][]") "][")
  181.                ((looking-at "[()]") ")(")
  182.                ((looking-at "[{}]") "{}")
  183.                ((looking-at "[<>]") "<>")
  184.                ((looking-at "[`']") "`'")
  185.                ((looking-at "\\^") "\\^")
  186.                ((viper-looking-at-separator) "")
  187.                (t (char-to-string (following-char))))
  188.          ))
  189.        
  190.        ;; Add `-' to alphanum, if it wasn't added and if we are in Lisp
  191.        (or (looking-at "-")
  192.        (not (string-match "lisp" (symbol-name major-mode)))
  193.        (setq modifiers (concat modifiers "C-C-")))
  194.        
  195.        
  196.        (save-excursion
  197.      (cond ((> click-count 1) (viper-skip-nonseparators 'backward))
  198.            ((viper-looking-at-alpha modifiers)
  199.         (viper-skip-alpha-backward modifiers))
  200.            ((not (viper-looking-at-alphasep modifiers))
  201.         (viper-skip-nonalphasep-backward))
  202.            (t (if (> click-count 1)
  203.               (viper-skip-nonseparators 'backward)
  204.             (viper-skip-alpha-backward modifiers))))
  205.  
  206.      (setq word-beg (point))
  207.      
  208.      (setq skip-flag nil) ; don't move 1 char forw the first time
  209.      (while (> count 0)
  210.        (if skip-flag (viper-forward-char-carefully 1))
  211.        (setq skip-flag t) ; now always move 1 char forward
  212.        (if (> click-count 1)
  213.            (viper-skip-nonseparators 'forward)
  214.          (viper-skip-alpha-forward modifiers))
  215.        (setq count (1- count)))
  216.  
  217.      (setq result (buffer-substring word-beg (point))))
  218.        ) ; if
  219.      ;; XEmacs doesn't have set-text-properties, but there buffer-substring
  220.      ;; doesn't return properties together with the string, so it's not needed.
  221.      (if viper-emacs-p
  222.      (set-text-properties 0 (length result) nil result))
  223.      result
  224.      ))
  225.  
  226.  
  227. (defun viper-mouse-click-get-word (click count click-count)
  228.   "Returns word surrounding the position of a mouse click.
  229. Click may be in another window. Current window and buffer isn't changed.
  230. On single or double click, returns the word as determined by
  231. `viper-surrounding-word-function'."
  232.      
  233.   (let ((click-word "")
  234.     (click-pos (viper-mouse-click-posn click))
  235.     (click-buf (viper-mouse-click-window-buffer click)))
  236.     (or (natnump count) (setq count 1))
  237.     (or (natnump click-count) (setq click-count 1))
  238.      
  239.     (save-excursion
  240.       (save-window-excursion
  241.     (if click-pos
  242.         (progn
  243.           (set-buffer click-buf)
  244.     
  245.           (goto-char click-pos)
  246.           (setq click-word
  247.             (funcall viper-surrounding-word-function count click-count)))
  248.       (error "Click must be over a window."))
  249.     click-word))))
  250.  
  251.  
  252. (defun viper-mouse-click-insert-word (click arg)
  253.   "Insert word clicked or double-clicked on.
  254. With prefix argument, N, insert that many words.
  255. This command must be bound to a mouse click.
  256. The double-click action of the same mouse button must not be bound
  257. \(or it must be bound to the same function\).
  258. See `viper-surrounding-word' for the definition of a word in this case."
  259.   (interactive "e\nP")
  260.   (if viper-frame-of-focus    ;; to handle clicks in another frame
  261.       (select-frame viper-frame-of-focus))
  262.   (if (or (not (eq (key-binding viper-mouse-down-insert-key-parsed)
  263.            'viper-mouse-catch-frame-switch))
  264.       (not (eq (key-binding viper-mouse-up-insert-key-parsed)
  265.            'viper-mouse-click-insert-word))
  266.       (and viper-xemacs-p (not (event-over-text-area-p click))))
  267.       () ; do nothing, if binding isn't right or not over text
  268.     ;; turn arg into a number
  269.     (cond ((integerp arg) nil)
  270.       ;; prefix arg is a list when one hits C-u then command
  271.       ((and (listp arg) (integerp (car arg)))
  272.        (setq arg (car arg)))
  273.       (t (setq arg 1)))
  274.     
  275.     (if (not (eq (key-binding viper-mouse-down-insert-key-parsed)
  276.          'viper-mouse-catch-frame-switch))
  277.     () ; do nothing
  278.       (let (click-count interrupting-event)
  279.     (if (and
  280.          (viper-multiclick-p)
  281.          ;; This trick checks if there is a pending mouse event if so, we
  282.          ;; use this latter event and discard the current mouse click If
  283.          ;; the next pending event is not a mouse event, we execute the
  284.          ;; current mouse event
  285.          (progn
  286.            (setq interrupting-event (viper-read-event))
  287.            (viper-mouse-event-p last-input-event)))
  288.         (progn ; interrupted wait
  289.           (setq viper-global-prefix-argument arg)
  290.           ;; count this click for XEmacs
  291.           (viper-event-click-count click))
  292.       ;; uninterrupted wait or the interrupting event wasn't a mouse event
  293.       (setq click-count (viper-event-click-count click))
  294.       (if (> click-count 1)
  295.           (setq arg viper-global-prefix-argument
  296.             viper-global-prefix-argument nil))
  297.       (insert (viper-mouse-click-get-word click arg click-count))
  298.       (if (and interrupting-event
  299.            (eventp interrupting-event)
  300.            (not (viper-mouse-event-p interrupting-event)))
  301.           (viper-set-unread-command-events interrupting-event))
  302.       )))))
  303.   
  304. ;; arg is an event. accepts symbols and numbers, too
  305. (defun viper-mouse-event-p (event)
  306.   (if (eventp event)
  307.       (string-match "\\(mouse-\\|frame\\|screen\\|track\\)"
  308.             (prin1-to-string (viper-event-key event)))))
  309.   
  310. ;; XEmacs has no double-click events. So, we must simulate.
  311. ;; So, we have to simulate event-click-count.
  312. (defun viper-event-click-count (click)
  313.   (if viper-xemacs-p
  314.       (progn
  315.     ;; if more than 1 second
  316.     (if (> (- (event-timestamp click) viper-last-click-event-timestamp)
  317.            viper-multiclick-timeout)
  318.         (setq viper-current-click-count 0))
  319.     (setq viper-last-click-event-timestamp (event-timestamp click)
  320.           viper-current-click-count (1+ viper-current-click-count)))
  321.     (event-click-count click)))
  322.     
  323.  
  324.  
  325. (defun viper-mouse-click-search-word (click arg)
  326.    "Find the word clicked or double-clicked on. Word may be in another window.
  327. With prefix argument, N, search for N-th occurrence.
  328. This command must be bound to a mouse click. The double-click action of the
  329. same button must not be bound \(or it must be bound to the same function\).
  330. See `viper-surrounding-word' for the details on what constitutes a word for
  331. this command."
  332.   (interactive "e\nP")
  333.   (if viper-frame-of-focus    ;; to handle clicks in another frame
  334.       (select-frame viper-frame-of-focus))
  335.   (if (or (not (eq (key-binding viper-mouse-down-search-key-parsed)
  336.            'viper-mouse-catch-frame-switch))
  337.       (not (eq (key-binding viper-mouse-up-search-key-parsed)
  338.            'viper-mouse-click-search-word))
  339.       (and viper-xemacs-p (not (event-over-text-area-p click))))
  340.       () ; do nothing, if binding isn't right or not over text
  341.     (let ((previous-search-string viper-s-string)
  342.       click-word click-count)
  343.     
  344.       (if (and
  345.        (viper-multiclick-p)
  346.        ;; This trick checks if there is a pending mouse event if so, we use
  347.        ;; this latter event and discard the current mouse click If the next
  348.        ;; pending event is not a mouse event, we execute the current mouse
  349.        ;; event
  350.        (progn
  351.          (viper-read-event)
  352.          (viper-mouse-event-p last-input-event)))
  353.       (progn ; interrupted wait
  354.         (setq viper-global-prefix-argument 
  355.           (or viper-global-prefix-argument arg))
  356.         ;; remember command that was before the multiclick
  357.         (setq this-command last-command)
  358.         ;; make sure we counted this event---needed for XEmacs only
  359.         (viper-event-click-count click))
  360.     ;; uninterrupted wait
  361.     (setq click-count (viper-event-click-count click))
  362.     (setq click-word (viper-mouse-click-get-word click nil click-count))
  363.     
  364.     (if (> click-count 1)
  365.         (setq arg viper-global-prefix-argument
  366.           viper-global-prefix-argument nil))
  367.     (setq arg (or arg 1))
  368.     
  369.     (viper-deactivate-mark)
  370.     (if (or (not (string= click-word viper-s-string))
  371.         (not (markerp viper-search-start-marker))
  372.         (not (equal (marker-buffer viper-search-start-marker)
  373.                 (current-buffer)))
  374.         (not (eq last-command 'viper-mouse-click-search-word)))
  375.         (progn
  376.           (setq  viper-search-start-marker (point-marker)
  377.              viper-local-search-start-marker viper-search-start-marker
  378.              viper-mouse-click-search-noerror t
  379.              viper-mouse-click-search-limit nil)
  380.           
  381.           ;; make search string known to Viper
  382.           (setq viper-s-string (if viper-re-search
  383.                        (regexp-quote click-word)
  384.                    click-word))
  385.           (if (not (string= viper-s-string (car viper-search-history)))
  386.           (setq viper-search-history
  387.             (cons viper-s-string viper-search-history)))
  388.           ))
  389.     
  390.     (push-mark nil t)
  391.     (while (> arg 0)
  392.       (viper-forward-word 1)
  393.       (condition-case nil
  394.           (progn
  395.         (if (not (search-forward
  396.               click-word viper-mouse-click-search-limit
  397.               viper-mouse-click-search-noerror))
  398.             (progn
  399.               (setq viper-mouse-click-search-noerror nil)
  400.               (setq viper-mouse-click-search-limit
  401.                 (save-excursion
  402.                   (if (and
  403.                    (markerp viper-local-search-start-marker)
  404.                    (marker-buffer viper-local-search-start-marker))
  405.                   (goto-char viper-local-search-start-marker))
  406.                   (viper-line-pos 'end)))
  407.               
  408.               (goto-char (point-min))
  409.               (search-forward click-word
  410.                       viper-mouse-click-search-limit nil)))
  411.         (goto-char (match-beginning 0))
  412.         (message "Searching for: %s" viper-s-string)
  413.         (if (<= arg 1) ; found the right occurrence of the pattern
  414.             (progn
  415.               (viper-adjust-window)
  416.               (viper-flash-search-pattern)))
  417.         )
  418.         (error (beep 1)
  419.            (if (or (not (string= click-word previous-search-string))
  420.                (not (eq  last-command 'viper-mouse-click-search-word)))
  421.                (message "`%s': String not found in %s"
  422.                 viper-s-string (buffer-name (current-buffer)))
  423.              (message
  424.               "`%s': Last occurrence in %s. Back to beginning of search"
  425.               click-word (buffer-name (current-buffer)))
  426.              (setq arg 1) ;; to terminate the loop
  427.              (sit-for 2))
  428.            (setq  viper-mouse-click-search-noerror t) 
  429.            (setq  viper-mouse-click-search-limit nil)
  430.            (if (and (markerp viper-local-search-start-marker)
  431.                 (marker-buffer viper-local-search-start-marker))
  432.                (goto-char viper-local-search-start-marker))))
  433.       (setq arg (1- arg)))
  434.     ))))
  435.   
  436. (defun viper-mouse-catch-frame-switch (event arg)
  437.   "Catch the event of switching frame.
  438. Usually is bound to a `down-mouse' event to work properly. See sample
  439. bindings in the Viper manual."
  440.   (interactive "e\nP")
  441.   (setq viper-frame-of-focus nil)
  442.   ;; pass prefix arg along to viper-mouse-click-search/insert-word
  443.   (setq prefix-arg arg)
  444.   (if (eq last-command 'handle-switch-frame)
  445.       (setq viper-frame-of-focus viper-current-frame-saved))
  446.   ;; make Emacs forget that it executed viper-mouse-catch-frame-switch
  447.   (setq this-command last-command))
  448.       
  449. ;; Called just before switching frames. Saves the old selected frame.
  450. ;; Sets last-command to handle-switch-frame (this is done automatically in
  451. ;; Emacs. 
  452. ;; The semantics of switching frames is different in Emacs and XEmacs.
  453. ;; In Emacs, if you select-frame A while mouse is over frame B and then
  454. ;; start typing, input goes to frame B, which becomes selected.
  455. ;; In XEmacs, input will go to frame A. This may be a bug in one of the
  456. ;; Emacsen, but also may be a design decision.
  457. ;; Also, in Emacs sending input to frame B generates handle-switch-frame
  458. ;; event, while in XEmacs it doesn't.
  459. ;; All this accounts for the difference in the behavior of
  460. ;; viper-mouse-click-* commands when you click in a frame other than the one
  461. ;; that was the last to receive input. In Emacs, focus will be in frame A
  462. ;; until you do something other than viper-mouse-click-* command.
  463. ;; In XEmacs, you have to manually select frame B (with the mouse click) in
  464. ;; order to shift focus to frame B.
  465. (defsubst viper-remember-current-frame (frame)
  466.   (setq last-command 'handle-switch-frame
  467.     viper-current-frame-saved (selected-frame)))
  468.  
  469.  
  470. ;; The key is of the form (MODIFIER ... BUTTON-NUMBER)
  471. ;; Converts into a valid mouse button spec for the appropriate version of
  472. ;; Emacs. EVENT-TYPE is either `up' or `down'. Up returns button-up key; down
  473. ;; returns button-down key.
  474. (defun viper-parse-mouse-key (key-var event-type)
  475.   (let ((key (eval key-var))
  476.     button-spec meta-spec shift-spec control-spec key-spec)
  477.     (if (null key)
  478.     ;; just return nil
  479.     ()
  480.       (setq button-spec
  481.         (cond ((memq 1 key)
  482.            (if viper-emacs-p
  483.                (if (eq 'up event-type)
  484.                "mouse-1" "down-mouse-1")
  485.              (if (eq 'up event-type)
  486.              'button1up 'button1)))
  487.           ((memq 2 key)
  488.            (if viper-emacs-p
  489.                (if (eq 'up event-type)
  490.                "mouse-2" "down-mouse-2")
  491.              (if (eq 'up event-type)
  492.              'button2up 'button2)))
  493.           ((memq 3 key)
  494.            (if viper-emacs-p
  495.                (if (eq 'up event-type)
  496.                "mouse-3" "down-mouse-3")
  497.              (if (eq 'up event-type)
  498.              'button3up 'button3)))
  499.           (t (error
  500.               "%S: invalid button number, %S" key-var key)))
  501.         meta-spec
  502.         (if (memq 'meta key)
  503.         (if viper-emacs-p "M-" 'meta)
  504.           (if viper-emacs-p "" nil))
  505.         shift-spec
  506.         (if (memq 'shift key)
  507.         (if viper-emacs-p "S-" 'shift)
  508.           (if viper-emacs-p "" nil))
  509.         control-spec
  510.         (if (memq 'control key)
  511.         (if viper-emacs-p "C-" 'control)
  512.           (if viper-emacs-p "" nil)))
  513.  
  514.       (setq key-spec (if viper-emacs-p
  515.              (vector
  516.               (intern
  517.                (concat
  518.                 control-spec meta-spec shift-spec button-spec)))
  519.                (vector
  520.             (delq
  521.              nil
  522.              (list
  523.               control-spec meta-spec shift-spec button-spec)))))
  524.       )))
  525.  
  526. (defun viper-unbind-mouse-search-key ()
  527.   (if viper-mouse-up-search-key-parsed
  528.       (global-unset-key viper-mouse-up-search-key-parsed))
  529.   (if viper-mouse-down-search-key-parsed
  530.       (global-unset-key viper-mouse-down-search-key-parsed))
  531.   (setq viper-mouse-up-search-key-parsed nil
  532.     viper-mouse-down-search-key-parsed nil))
  533.  
  534. (defun viper-unbind-mouse-insert-key ()
  535.   (if viper-mouse-up-insert-key-parsed
  536.       (global-unset-key viper-mouse-up-insert-key-parsed))
  537.   (if viper-mouse-down-insert-key-parsed
  538.       (global-unset-key viper-mouse-down-insert-key-parsed))
  539.   (setq viper-mouse-up-insert-key-parsed nil
  540.     viper-mouse-down-insert-key-parsed nil))
  541.  
  542. ;; If FORCE, bind even if this mouse action is already bound to something else
  543. (defun viper-bind-mouse-search-key (&optional force)
  544.   (setq viper-mouse-up-search-key-parsed
  545.     (viper-parse-mouse-key 'viper-mouse-search-key 'up)
  546.     viper-mouse-down-search-key-parsed
  547.     (viper-parse-mouse-key 'viper-mouse-search-key 'down))
  548.   (cond ((or (null viper-mouse-up-search-key-parsed)
  549.          (null viper-mouse-down-search-key-parsed))
  550.      nil) ; just quit
  551.     ((and (null force) 
  552.           (key-binding viper-mouse-up-search-key-parsed)
  553.           (not (eq (key-binding viper-mouse-up-search-key-parsed)
  554.                'viper-mouse-click-search-word)))
  555.      (message 
  556.       "%S already bound to a mouse event. Viper mouse-search feature disabled"
  557.       viper-mouse-up-search-key-parsed))
  558.     ((and (null force) 
  559.           (key-binding viper-mouse-down-search-key-parsed)
  560.           (not (eq (key-binding viper-mouse-down-search-key-parsed)
  561.                'viper-mouse-catch-frame-switch)))
  562.      (message
  563.       "%S already bound to a mouse event. Viper mouse-search feature disabled"
  564.       viper-mouse-down-search-key-parsed))
  565.     (t 
  566.      (global-set-key viper-mouse-up-search-key-parsed
  567.              'viper-mouse-click-search-word)
  568.      (global-set-key viper-mouse-down-search-key-parsed
  569.              'viper-mouse-catch-frame-switch))))
  570.  
  571. ;; If FORCE, bind even if this mouse action is already bound to something else
  572. (defun viper-bind-mouse-insert-key (&optional force)
  573.   (setq viper-mouse-up-insert-key-parsed
  574.     (viper-parse-mouse-key 'viper-mouse-insert-key 'up)
  575.     viper-mouse-down-insert-key-parsed
  576.     (viper-parse-mouse-key 'viper-mouse-insert-key 'down))
  577.   (cond ((or (null viper-mouse-up-insert-key-parsed)
  578.          (null viper-mouse-down-insert-key-parsed))
  579.      nil) ; just quit
  580.     ((and (null force)
  581.           (key-binding viper-mouse-up-insert-key-parsed)
  582.           (not (eq (key-binding viper-mouse-up-insert-key-parsed)
  583.                'viper-mouse-click-insert-word)))
  584.      (message 
  585.       "%S already bound to a mouse event. Viper mouse-insert feature disabled"
  586.       viper-mouse-up-insert-key-parsed))
  587.     ((and (null force)
  588.           (key-binding viper-mouse-down-insert-key-parsed)
  589.           (not (eq (key-binding viper-mouse-down-insert-key-parsed)
  590.                'viper-mouse-catch-frame-switch)))
  591.      (message
  592.       "%S already bound to a mouse event. Viper mouse-insert feature disabled"
  593.       viper-mouse-down-insert-key-parsed))
  594.     (t 
  595.      (global-set-key viper-mouse-up-insert-key-parsed
  596.              'viper-mouse-click-insert-word)
  597.      (global-set-key viper-mouse-down-insert-key-parsed
  598.              'viper-mouse-catch-frame-switch))))
  599.  
  600. (defun viper-reset-mouse-search-key (symb val)
  601.   (viper-unbind-mouse-search-key)
  602.   (set symb val)
  603.   (viper-bind-mouse-search-key 'force))
  604.  
  605. (defun viper-reset-mouse-insert-key (symb val)
  606.   (viper-unbind-mouse-insert-key)
  607.   (set symb val)
  608.   (viper-bind-mouse-insert-key 'force))
  609.  
  610.  
  611. (defcustom viper-mouse-search-key '(meta shift 1)
  612.   "*Key used to click-search in Viper.
  613. This must be a list that specifies the mouse button and modifiers.
  614. The supported modifiers are `meta', `shift', and `control'.
  615. For instance, `(meta shift 1)' means that holding the meta and shift
  616. keys down and clicking on a word with mouse button 1
  617. will search for that word in the buffer that was current before the click.
  618. This buffer may be different from the one where the click occurred."
  619.   :type '(list (set :inline t :tag "Modifiers" :format "%t: %v"
  620.              (const :format "%v " meta)
  621.              (const :format "%v " shift)
  622.              (const control))
  623.            (integer :tag "Button"))
  624.   :set 'viper-reset-mouse-search-key
  625.   :group 'viper-mouse)
  626.  
  627. (defcustom viper-mouse-insert-key '(meta shift 2)
  628.   "*Key used to click-insert in Viper.
  629. Must be a list that specifies the mouse button and modifiers.
  630. The supported modifiers are `meta', `shift', and `control'.
  631. For instance, `(meta shift 2)' means that holding the meta and shift keys
  632. down, and clicking on a word with mouse button 2, will insert that word
  633. at the cursor in the buffer that was current just before the click.
  634. This buffer may be different from the one where the click occurred."
  635.   :type '(list (set :inline t :tag "Modifiers" :format "%t: %v"
  636.              (const :format "%v " meta)
  637.              (const :format "%v " shift)
  638.              (const control))
  639.            (integer :tag "Button"))
  640.   :set 'viper-reset-mouse-insert-key
  641.   :group 'viper-mouse)
  642.        
  643.  
  644.  
  645. ;;; Local Variables:
  646. ;;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
  647. ;;; End:
  648.  
  649.  
  650. ;;;  viper-mous.el ends here
  651.